initial_rows <- nrow(data_analysis)
data_prep <- data_analysis %>%
filter(Screen == "Message")
filtered_rows <- initial_rows - nrow(data_prep)
filtered_rows[1] 5389
Important: Filter out the responses to the Question (Screen != Question) as we only model the truth ratings for now!
initial_rows <- nrow(data_analysis)
data_prep <- data_analysis %>%
filter(Screen == "Message")
filtered_rows <- initial_rows - nrow(data_prep)
filtered_rows[1] 5389
I also only want the political question topics and for these analyses I only keep Pro and Anti motive.
data_pol <- data_prep %>%
filter(question_type == "political") %>%
mutate(question_topic = factor(question_topic,
levels = c("climate",
"gender",
"immigration",
"discrimination",
"adoption",
"punishment"))) %>%
droplevels()
levels(data_pol$question_topic)[1] "climate" "gender" "immigration" "discrimination" "adoption"
[6] "punishment"
As we will model monotonic effects, we have to transform the ideo_motive_strength variable into an ordered factor.
data_pol <- data_pol %>%
mutate(ideo_motive_strength = factor(ideo_motive_strength,
levels = c("Anti-strong",
"Anti-moderate",
"Anti-weak",
"Neutral",
"Pro-weak",
"Pro-moderate",
"Pro-strong"),
ordered = TRUE)) m1.pol: response_proportion ~ ideo_motive + (ideo_motive | subj_idx) + (ideo_motive | question_topic)
Check some settings:
print(contrasts(data_pol$ideo_motive)) Neutral Pro
Anti 0 0
Neutral 1 0
Pro 0 1
Set model formula
f_m1.pol <- bf(response_proportion ~ ideo_motive +
(ideo_motive | subj_idx) +
(ideo_motive | question_topic), center = T)And fit the ordered beta regression:
m1.pol <- ordbetareg(formula = f_m1.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m1.pol"))print(m1.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ ideo_motive + (ideo_motive | subj_idx) + (ideo_motive | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.06 0.05 0.00 0.17 1.00 2852
sd(ideo_motiveNeutral) 0.15 0.15 0.01 0.52 1.00 3932
sd(ideo_motivePro) 0.18 0.11 0.06 0.46 1.00 2623
cor(Intercept,ideo_motiveNeutral) -0.04 0.41 -0.77 0.74 1.00 9730
cor(Intercept,ideo_motivePro) -0.31 0.39 -0.90 0.55 1.00 4581
cor(ideo_motiveNeutral,ideo_motivePro) 0.04 0.40 -0.72 0.77 1.00 5243
Tail_ESS
sd(Intercept) 3328
sd(ideo_motiveNeutral) 4424
sd(ideo_motivePro) 3361
cor(Intercept,ideo_motiveNeutral) 5857
cor(Intercept,ideo_motivePro) 5477
cor(ideo_motiveNeutral,ideo_motivePro) 6496
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.29 0.04 0.21 0.37 1.00 1508
sd(ideo_motiveNeutral) 0.19 0.14 0.01 0.52 1.00 2006
sd(ideo_motivePro) 0.25 0.11 0.02 0.43 1.01 399
cor(Intercept,ideo_motiveNeutral) -0.18 0.41 -0.84 0.66 1.00 4086
cor(Intercept,ideo_motivePro) -0.41 0.27 -0.75 0.30 1.00 1259
cor(ideo_motiveNeutral,ideo_motivePro) 0.08 0.40 -0.70 0.78 1.01 742
Tail_ESS
sd(Intercept) 3149
sd(ideo_motiveNeutral) 3296
sd(ideo_motivePro) 630
cor(Intercept,ideo_motiveNeutral) 5222
cor(Intercept,ideo_motivePro) 1085
cor(ideo_motiveNeutral,ideo_motivePro) 1568
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept 0.01 0.04 -0.07 0.09 1.00 6347 5236
ideo_motiveNeutral 0.15 0.14 -0.12 0.42 1.00 5259 4623
ideo_motivePro 0.22 0.10 0.03 0.41 1.00 2830 2518
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.71 0.11 3.50 3.92 1.00 2266 3736
cutzero -3.66 0.12 -3.90 -3.43 1.00 9637 5998
cutone 2.03 0.02 1.98 2.07 1.00 9195 6515
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
pp_check_ordbeta(m1.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m1.pol.png"),
width = 12, height = 6)Check the trace and density plots.
mcmc_plot(m1.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m1.pol.png"),
width = 18, height = 14)mcmc_plot(m1.pol, type = 'dens')ggsave(here(dia_dir, "density_plot_m1.pol.png"), width = 18, height = 14)m2.pol: response_proportion ~ ideo_motive_strength + (ideo_motive_strength | subj_idx) + (ideo_motive_strength | question_topic)
Set model formula
f_m2.pol <- bf(response_proportion ~
mo(ideo_motive_strength) +
(mo(ideo_motive_strength) | subj_idx) +
(mo(ideo_motive_strength) | question_topic), center = T)And fit the ordered beta regression:
m2.pol <- ordbetareg(formula = f_m2.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m2.pol"))print(m2.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ mo(ideo_motive_strength) + (mo(ideo_motive_strength) | subj_idx) + (mo(ideo_motive_strength) | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.13 0.08 0.02 0.32 1.00 1866
sd(moideo_motive_strength) 0.06 0.03 0.02 0.14 1.00 2211
cor(Intercept,moideo_motive_strength) -0.61 0.33 -0.98 0.25 1.00 3003
Tail_ESS
sd(Intercept) 1915
sd(moideo_motive_strength) 3491
cor(Intercept,moideo_motive_strength) 4323
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.28 0.06 0.18 0.40 1.00 1119
sd(moideo_motive_strength) 0.05 0.03 0.00 0.11 1.00 350
cor(Intercept,moideo_motive_strength) -0.33 0.37 -0.82 0.61 1.00 974
Tail_ESS
sd(Intercept) 2596
sd(moideo_motive_strength) 1467
cor(Intercept,moideo_motive_strength) 1685
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
Intercept -0.06 0.08 -0.24 0.09 1.00 3900 4299
moideo_motive_strength 0.07 0.03 0.01 0.14 1.00 3690 4554
Monotonic Simplex Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
moideo_motive_strength1[1] 0.11 0.09 0.00 0.32 1.00 4192 4441
moideo_motive_strength1[2] 0.18 0.10 0.01 0.38 1.00 4268 3154
moideo_motive_strength1[3] 0.18 0.12 0.01 0.45 1.00 5332 4440
moideo_motive_strength1[4] 0.17 0.11 0.01 0.44 1.00 6153 4012
moideo_motive_strength1[5] 0.08 0.06 0.00 0.24 1.00 7979 5443
moideo_motive_strength1[6] 0.29 0.13 0.03 0.53 1.00 4261 4559
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.68 0.10 3.48 3.89 1.00 2684 4565
cutzero -3.66 0.12 -3.90 -3.42 1.00 8434 5734
cutone 2.02 0.02 1.98 2.07 1.00 8296 6538
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
pp_check_ordbeta(m2.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m2.pol.png"),
width = 12, height = 6)Check the trace and density plots:
mcmc_plot(m2.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m2.pol.png"),
width = 18, height = 14)mcmc_plot(m2.pol, type = 'dens')ggsave(here(dia_dir, "density_plot_m2.pol.png"), width = 18, height = 14)m3.pol: response_proportion ~ ideo_motive * crt + (ideo_motive | subj_idx) + (ideo_motive | question_topic)
Set model formula
f_m3.pol <- bf(response_proportion ~ ideo_motive * scale(crt_correct) +
(ideo_motive | subj_idx) +
(ideo_motive | question_topic), center = T)And fit the ordered beta regression:
m3.pol <- ordbetareg(formula = f_m3.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m3.pol"))print(m3.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ ideo_motive * scale(crt_correct) + (ideo_motive | subj_idx) + (ideo_motive | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.06 0.05 0.00 0.18 1.00 3194
sd(ideo_motiveNeutral) 0.15 0.14 0.01 0.52 1.00 4044
sd(ideo_motivePro) 0.18 0.11 0.06 0.45 1.00 3278
cor(Intercept,ideo_motiveNeutral) -0.04 0.41 -0.77 0.73 1.00 11849
cor(Intercept,ideo_motivePro) -0.31 0.39 -0.90 0.55 1.00 4407
cor(ideo_motiveNeutral,ideo_motivePro) 0.03 0.40 -0.73 0.77 1.00 5708
Tail_ESS
sd(Intercept) 4423
sd(ideo_motiveNeutral) 4145
sd(ideo_motivePro) 3990
cor(Intercept,ideo_motiveNeutral) 6521
cor(Intercept,ideo_motivePro) 4665
cor(ideo_motiveNeutral,ideo_motivePro) 6229
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.29 0.04 0.21 0.37 1.00 1551
sd(ideo_motiveNeutral) 0.19 0.14 0.01 0.54 1.00 2311
sd(ideo_motivePro) 0.26 0.11 0.03 0.43 1.01 525
cor(Intercept,ideo_motiveNeutral) -0.19 0.41 -0.83 0.66 1.00 5080
cor(Intercept,ideo_motivePro) -0.43 0.26 -0.76 0.25 1.00 1335
cor(ideo_motiveNeutral,ideo_motivePro) 0.06 0.41 -0.74 0.78 1.00 767
Tail_ESS
sd(Intercept) 3634
sd(ideo_motiveNeutral) 3693
sd(ideo_motivePro) 845
cor(Intercept,ideo_motiveNeutral) 5446
cor(Intercept,ideo_motivePro) 1547
cor(ideo_motiveNeutral,ideo_motivePro) 2137
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
Intercept 0.01 0.04 -0.08 0.09 1.00 7459
ideo_motiveNeutral 0.12 0.14 -0.15 0.40 1.00 6849
ideo_motivePro 0.22 0.09 0.04 0.41 1.00 4599
scalecrt_correct 0.04 0.03 -0.02 0.09 1.00 8034
ideo_motiveNeutral:scalecrt_correct -0.14 0.11 -0.36 0.08 1.00 9186
ideo_motivePro:scalecrt_correct -0.00 0.04 -0.07 0.07 1.00 9543
Tail_ESS
Intercept 5890
ideo_motiveNeutral 5768
ideo_motivePro 4181
scalecrt_correct 6808
ideo_motiveNeutral:scalecrt_correct 6282
ideo_motivePro:scalecrt_correct 6818
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.72 0.11 3.50 3.93 1.00 2117 3953
cutzero -3.66 0.12 -3.90 -3.43 1.00 10056 5940
cutone 2.03 0.02 1.98 2.07 1.00 8853 6542
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
pp_check_ordbeta(m3.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m3.pol.png"),
width = 12, height = 6)Check the trace and density plots:
mcmc_plot(m3.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m3.pol.png"),
width = 18, height = 14)mcmc_plot(m3.pol, type = 'dens')ggsave(here(dia_dir, "density_plot_m3.pol.png"), width = 18, height = 14)m4.pol: response_proportion ~ ideo_motive * commission_errors_r + (ideo_motive | subj_idx) + (ideo_motive | question_topic)
Set model formula
f_m4.pol <- bf(response_proportion ~ ideo_motive * scale(commission_errors_r) +
(ideo_motive | subj_idx) +
(ideo_motive | question_topic), center = T)And fit the ordered beta regression:
m4.pol <- ordbetareg(formula = f_m4.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m4.pol"))print(m4.pol)Warning: There were 1 divergent transitions after warmup. Increasing adapt_delta above
0.99 may help. See
http://mc-stan.org/misc/warnings.html#divergent-transitions-after-warmup
Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ ideo_motive * scale(commission_errors_r) + (ideo_motive | subj_idx) + (ideo_motive | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.06 0.05 0.00 0.18 1.00 2694
sd(ideo_motiveNeutral) 0.15 0.14 0.01 0.51 1.00 4252
sd(ideo_motivePro) 0.18 0.11 0.06 0.45 1.00 2352
cor(Intercept,ideo_motiveNeutral) -0.04 0.41 -0.77 0.72 1.00 9789
cor(Intercept,ideo_motivePro) -0.31 0.40 -0.90 0.56 1.00 3844
cor(ideo_motiveNeutral,ideo_motivePro) 0.04 0.41 -0.73 0.78 1.00 4862
Tail_ESS
sd(Intercept) 3211
sd(ideo_motiveNeutral) 4694
sd(ideo_motivePro) 2150
cor(Intercept,ideo_motiveNeutral) 6416
cor(Intercept,ideo_motivePro) 4895
cor(ideo_motiveNeutral,ideo_motivePro) 6255
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.29 0.04 0.21 0.37 1.00 1319
sd(ideo_motiveNeutral) 0.19 0.15 0.01 0.53 1.00 1736
sd(ideo_motivePro) 0.26 0.10 0.03 0.43 1.01 434
cor(Intercept,ideo_motiveNeutral) -0.17 0.40 -0.83 0.67 1.00 4300
cor(Intercept,ideo_motivePro) -0.43 0.25 -0.76 0.25 1.00 1141
cor(ideo_motiveNeutral,ideo_motivePro) 0.07 0.40 -0.70 0.77 1.00 705
Tail_ESS
sd(Intercept) 3419
sd(ideo_motiveNeutral) 3523
sd(ideo_motivePro) 691
cor(Intercept,ideo_motiveNeutral) 4483
cor(Intercept,ideo_motivePro) 1449
cor(ideo_motiveNeutral,ideo_motivePro) 1852
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat
Intercept 0.01 0.04 -0.07 0.09 1.00
ideo_motiveNeutral 0.14 0.14 -0.14 0.41 1.00
ideo_motivePro 0.22 0.10 0.04 0.41 1.00
scalecommission_errors_r -0.01 0.03 -0.06 0.05 1.00
ideo_motiveNeutral:scalecommission_errors_r 0.11 0.13 -0.15 0.37 1.00
ideo_motivePro:scalecommission_errors_r 0.00 0.04 -0.07 0.08 1.00
Bulk_ESS Tail_ESS
Intercept 6605 5552
ideo_motiveNeutral 6869 5846
ideo_motivePro 3107 1951
scalecommission_errors_r 8281 6339
ideo_motiveNeutral:scalecommission_errors_r 8913 6314
ideo_motivePro:scalecommission_errors_r 9068 6207
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.71 0.11 3.50 3.93 1.00 1844 4698
cutzero -3.66 0.12 -3.91 -3.42 1.00 9885 6327
cutone 2.03 0.02 1.98 2.07 1.00 9119 6154
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
pp_check_ordbeta(m4.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m4.pol.png"),
width = 12, height = 6)Check the trace and density plots:
mcmc_plot(m4.pol, type = 'trace')ggsave(here(dia_dir, "trace_plot_m4.pol.png"),
width = 18, height = 14)mcmc_plot(m4.pol, type = 'dens')ggsave(here(dia_dir, "density_plot_m4.pol.png"), width = 18, height = 14)m5.pol: response_proportion ~ ideo_motive_strength * crt + (ideo_motive_strength | subj_idx) + (ideo_motive_strength | question_topic)
Set model formula
f_m5.pol <- bf(response_proportion ~ mo(ideo_motive_strength) * scale(crt_correct) +
(mo(ideo_motive_strength) | subj_idx) +
(mo(ideo_motive_strength) | question_topic), center = T)And fit the ordered beta regression:
m5.pol <- ordbetareg(formula = f_m5.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m5.pol"))print(m5.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ mo(ideo_motive_strength) * scale(crt_correct) + (mo(ideo_motive_strength) | subj_idx) + (mo(ideo_motive_strength) | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.13 0.08 0.02 0.33 1.00 1902
sd(moideo_motive_strength) 0.06 0.03 0.02 0.14 1.00 2139
cor(Intercept,moideo_motive_strength) -0.61 0.33 -0.98 0.26 1.00 2667
Tail_ESS
sd(Intercept) 1854
sd(moideo_motive_strength) 3121
cor(Intercept,moideo_motive_strength) 3664
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.28 0.06 0.18 0.41 1.01 953
sd(moideo_motive_strength) 0.05 0.03 0.00 0.11 1.02 303
cor(Intercept,moideo_motive_strength) -0.37 0.35 -0.82 0.53 1.01 785
Tail_ESS
sd(Intercept) 2733
sd(moideo_motive_strength) 821
cor(Intercept,moideo_motive_strength) 1704
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat
Intercept -0.06 0.09 -0.26 0.08 1.00
scalecrt_correct 0.04 0.05 -0.04 0.14 1.00
moideo_motive_strength 0.07 0.03 0.01 0.14 1.00
moideo_motive_strength:scalecrt_correct -0.00 0.01 -0.03 0.02 1.00
Bulk_ESS Tail_ESS
Intercept 2509 3156
scalecrt_correct 4370 3260
moideo_motive_strength 2590 3174
moideo_motive_strength:scalecrt_correct 4250 3411
Monotonic Simplex Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat
moideo_motive_strength1[1] 0.11 0.09 0.00 0.32 1.00
moideo_motive_strength1[2] 0.17 0.10 0.01 0.39 1.00
moideo_motive_strength1[3] 0.19 0.12 0.01 0.46 1.00
moideo_motive_strength1[4] 0.17 0.11 0.01 0.44 1.00
moideo_motive_strength1[5] 0.08 0.06 0.00 0.24 1.00
moideo_motive_strength1[6] 0.28 0.13 0.03 0.53 1.00
moideo_motive_strength:scalecrt_correct1[1] 0.20 0.16 0.01 0.59 1.00
moideo_motive_strength:scalecrt_correct1[2] 0.16 0.14 0.00 0.52 1.00
moideo_motive_strength:scalecrt_correct1[3] 0.15 0.13 0.00 0.49 1.00
moideo_motive_strength:scalecrt_correct1[4] 0.15 0.13 0.00 0.49 1.00
moideo_motive_strength:scalecrt_correct1[5] 0.15 0.14 0.00 0.52 1.00
moideo_motive_strength:scalecrt_correct1[6] 0.19 0.15 0.01 0.57 1.00
Bulk_ESS Tail_ESS
moideo_motive_strength1[1] 3517 4362
moideo_motive_strength1[2] 3402 2871
moideo_motive_strength1[3] 4565 4259
moideo_motive_strength1[4] 5218 4608
moideo_motive_strength1[5] 6832 5206
moideo_motive_strength1[6] 4592 4687
moideo_motive_strength:scalecrt_correct1[1] 5975 4133
moideo_motive_strength:scalecrt_correct1[2] 9441 4278
moideo_motive_strength:scalecrt_correct1[3] 9262 4071
moideo_motive_strength:scalecrt_correct1[4] 9665 4671
moideo_motive_strength:scalecrt_correct1[5] 9976 5915
moideo_motive_strength:scalecrt_correct1[6] 8400 4929
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.69 0.11 3.49 3.89 1.00 2108 4050
cutzero -3.66 0.12 -3.91 -3.42 1.00 7238 5611
cutone 2.02 0.02 1.98 2.07 1.00 7331 6051
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
pp_check_ordbeta(m5.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m5.pol.png"),
width = 12, height = 6)Check the trace and density plots:
mcmc_plot(m5.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m5.pol.png"),
width = 18, height = 14)mcmc_plot(m5.pol, type = 'dens')ggsave(here(dia_dir, "density_plot_m5.pol.png"), width = 18, height = 14)m6.pol: response_proportion ~ ideo_motive_strength * commission_errors_r + (ideo_motive_strength | subj_idx) + (ideo_motive_strength | question_topic)
Set model formula
f_m6.pol <- bf(response_proportion ~ mo(ideo_motive_strength) * scale(commission_errors_r) +
(mo(ideo_motive_strength) | subj_idx) +
(mo(ideo_motive_strength) | question_topic), center = T)And fit the ordered beta regression:
m6.pol <- ordbetareg(formula = f_m6.pol,
data = data_pol,
coef_prior_mean = 0,
coef_prior_SD = 1.5,
intercept_prior_mean = 0,
intercept_prior_SD = 1.5,
extra_prior = set_prior("lkj(2)", class = "L"),
seed = bayes_seed,
chains=4,
iter=4000,
true_bounds = c(0, 1),
control = list(adapt_delta = 0.99,
max_treedepth = 12),
file = here(model_dir, "m6.pol"))print(m6.pol) Family: ord_beta_reg
Links: mu = identity; phi = identity; cutzero = identity; cutone = identity
Formula: response_proportion ~ mo(ideo_motive_strength) * scale(commission_errors_r) + (mo(ideo_motive_strength) | subj_idx) + (mo(ideo_motive_strength) | question_topic)
Data: data (Number of observations: 3018)
Draws: 4 chains, each with iter = 4000; warmup = 2000; thin = 1;
total post-warmup draws = 8000
Multilevel Hyperparameters:
~question_topic (Number of levels: 6)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.13 0.09 0.02 0.35 1.00 1741
sd(moideo_motive_strength) 0.06 0.03 0.02 0.14 1.00 1986
cor(Intercept,moideo_motive_strength) -0.60 0.34 -0.98 0.29 1.00 2606
Tail_ESS
sd(Intercept) 1776
sd(moideo_motive_strength) 2210
cor(Intercept,moideo_motive_strength) 3311
~subj_idx (Number of levels: 504)
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
sd(Intercept) 0.28 0.06 0.18 0.40 1.01 609
sd(moideo_motive_strength) 0.05 0.03 0.00 0.11 1.03 256
cor(Intercept,moideo_motive_strength) -0.35 0.36 -0.81 0.57 1.01 607
Tail_ESS
sd(Intercept) 1975
sd(moideo_motive_strength) 1278
cor(Intercept,moideo_motive_strength) 1928
Regression Coefficients:
Estimate Est.Error l-95% CI u-95% CI Rhat
Intercept -0.06 0.08 -0.24 0.09 1.00
scalecommission_errors_r 0.01 0.05 -0.07 0.11 1.00
moideo_motive_strength 0.07 0.03 0.01 0.14 1.00
moideo_motive_strength:scalecommission_errors_r -0.00 0.01 -0.03 0.02 1.00
Bulk_ESS Tail_ESS
Intercept 2595 3297
scalecommission_errors_r 3317 2104
moideo_motive_strength 2000 2497
moideo_motive_strength:scalecommission_errors_r 3430 2166
Monotonic Simplex Parameters:
Estimate Est.Error l-95% CI u-95% CI
moideo_motive_strength1[1] 0.10 0.09 0.00 0.32
moideo_motive_strength1[2] 0.17 0.10 0.01 0.38
moideo_motive_strength1[3] 0.18 0.12 0.01 0.46
moideo_motive_strength1[4] 0.18 0.12 0.01 0.45
moideo_motive_strength1[5] 0.08 0.07 0.00 0.25
moideo_motive_strength1[6] 0.29 0.13 0.03 0.53
moideo_motive_strength:scalecommission_errors_r1[1] 0.20 0.17 0.01 0.60
moideo_motive_strength:scalecommission_errors_r1[2] 0.16 0.13 0.00 0.50
moideo_motive_strength:scalecommission_errors_r1[3] 0.15 0.13 0.00 0.49
moideo_motive_strength:scalecommission_errors_r1[4] 0.15 0.13 0.00 0.49
moideo_motive_strength:scalecommission_errors_r1[5] 0.16 0.14 0.00 0.51
moideo_motive_strength:scalecommission_errors_r1[6] 0.18 0.15 0.01 0.55
Rhat Bulk_ESS Tail_ESS
moideo_motive_strength1[1] 1.00 3135 3918
moideo_motive_strength1[2] 1.00 3460 2525
moideo_motive_strength1[3] 1.00 4004 3446
moideo_motive_strength1[4] 1.00 4188 4771
moideo_motive_strength1[5] 1.00 6296 4713
moideo_motive_strength1[6] 1.00 4088 3937
moideo_motive_strength:scalecommission_errors_r1[1] 1.00 6011 4817
moideo_motive_strength:scalecommission_errors_r1[2] 1.00 8615 4532
moideo_motive_strength:scalecommission_errors_r1[3] 1.00 8370 4396
moideo_motive_strength:scalecommission_errors_r1[4] 1.00 7675 4234
moideo_motive_strength:scalecommission_errors_r1[5] 1.00 9468 5415
moideo_motive_strength:scalecommission_errors_r1[6] 1.00 8192 5627
Further Distributional Parameters:
Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
phi 3.68 0.10 3.48 3.89 1.00 1520 4304
cutzero -3.65 0.12 -3.90 -3.43 1.00 7354 5667
cutone 2.02 0.02 1.98 2.07 1.00 7137 5817
Draws were sampled using sample(hmc). For each parameter, Bulk_ESS
and Tail_ESS are effective sample size measures, and Rhat is the potential
scale reduction factor on split chains (at convergence, Rhat = 1).
pp_check_ordbeta(m5.pol, ndraws = 50)$discrete
$continuous
ggsave(here(dia_dir, "ppc_m6.pol.png"),
width = 12, height = 6)Check the trace and density plots:
mcmc_plot(m6.pol, type = 'trace')No divergences to plot.
ggsave(here(dia_dir, "trace_plot_m6.pol.png"),
width = 18, height = 14)mcmc_plot(m6.pol, type = 'dens')ggsave(here(dia_dir, "density_plot_m6.pol.png"), width = 18, height = 14)